home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok71.lha / RemapInfo / RemapInfo.mod < prev    next >
Text File  |  1993-08-15  |  16KB  |  486 lines
  1. (**************************************************************************
  2.  
  3. :Program.       RemapInfo
  4.  
  5. :Contents.      das tausendunderste Programm, das (a) die Farben eines
  6.                 Icons an die WBench 2.0 anpasst und (b) aus einem kaputten
  7.                 4 Farben Icon (die 3. Bitplane enthält Müll) ein echtes
  8.                 4 Farben Icon macht.
  9.  
  10. :Usage.         RemapInfo [±KILLPLANES] [±REMAP]
  11.  
  12.  
  13. :Copyright.     © 1992 by:
  14.  
  15. :Author.        Thomas Ansorge
  16.  
  17. :Address.       Dinkelackerring 55, W-6730 Neustadt, Deutschland
  18.  
  19.  
  20. :Language.      Modula-2
  21.  
  22. :Translator.    M2Amiga V4.0 (deutsch)
  23.  
  24.  
  25. :Version.       0.9 vom 22. März 1992
  26.  
  27. :History.       0.9 vom 22.03.1992: es läuft (<=> es stürzt nicht ab)
  28.  
  29.  
  30. **************************************************************************)
  31.  
  32.  
  33. MODULE RemapInfo;
  34.  
  35. FROM Arguments IMPORT GetArg, GetLock, NumArgs;
  36.  
  37. FROM Arts IMPORT Assert, returnVal, Terminate, thisTask, wbStarted;
  38.  
  39. FROM DosD IMPORT FileHandlePtr, FileInfoBlock, FileLock, FileLockPtr,
  40.    newFile, ticksPerSecond;
  41.  
  42. FROM DosL IMPORT CurrentDir, Delay, Examine, Output, ParentDir, Write;
  43.  
  44. FROM DosSupport IMPORT Close, Open;
  45.  
  46. FROM ExecL IMPORT FreeMem;
  47.  
  48. FROM IconL IMPORT FindToolType, FreeDiskObject, GetDiskObject,
  49.    PutDiskObject;
  50.  
  51. FROM IntuitionD IMPORT boolGadget, Gadget, GadgetFlags, GadgetFlagSet,
  52.    Image, ImagePtr;
  53.  
  54. FROM String IMPORT CapString, Compare, Copy, Length;
  55.  
  56. FROM SYSTEM IMPORT ADR, ADDRESS, ASSEMBLE;
  57.  
  58. FROM WorkbenchD IMPORT DiskObject, DiskObjectPtr;
  59.  
  60. (* --------------------------------------------------------------------- *)
  61.  
  62. CONST RemapText = " \e[1mRemapInfo\e[0m";
  63.       ErrorText = " ERROR ->";
  64.  
  65.       RemapOptText = "REMAP";
  66.       KillPOptText = "KILLPLANES";
  67.  
  68. CONST Copyright = "\n" + RemapText + " © 1992 Thomas Ansorge\n\n\o";
  69.  
  70. CONST Start1Text = " " + RemapOptText + " is switched ON as default.\n\o";
  71.       Start2Text = " " + KillPOptText + " is switched OFF as default.\n\n\o";
  72.  
  73. CONST RemapOnText       = "\n " + RemapOptText + " is switched ON now!\n\n\o";
  74.       RemapOffText      = "\n " + RemapOptText + " is switched OFF now!\n\n\o";
  75.       KillPlanesOnText  = "\n " + KillPOptText + " is switched ON now!\n\n\o";
  76.       KillPlanesOffText = "\n " + KillPOptText + " is switched OFF now!\n\n\o";
  77.  
  78. CONST Processing1Text = " Processing \"\o";
  79.       Processing2Text = ".info\" ...\n\o";
  80.  
  81. CONST NoIcon1Text = ErrorText + " Could not find icon \"\o";
  82.       NoIcon2Text = ".info\"!\n\o";
  83.  
  84.       Typ1Text = ErrorText + " Icon \"\o";
  85.       Typ2Text = ".info\" is not of required type!\n\o";
  86.  
  87.       KeinOutputText = "Could not open output window!\o";
  88.  
  89. CONST WinDefs = "CON:70/11/540/152/RemapInfo\o";
  90.  
  91. CONST OptPlus  = "+";
  92.       OptMinus = "-";
  93.  
  94.       OptKillPlanesPlus     = OptPlus + KillPOptText;
  95.       OptKillPlanesMinus    = OptMinus + KillPOptText;
  96.       OptRemapPlus          = OptPlus + RemapOptText;
  97.       OptRemapMinus         = OptMinus + RemapOptText;
  98.  
  99. CONST DefKillPlanes = FALSE;
  100.       DefRemap      = TRUE;
  101.  
  102. CONST Seconds = 10;
  103.  
  104. CONST StringMax = 255;
  105.  
  106. TYPE String = ARRAY [0..StringMax] OF CHAR;
  107.  
  108. TYPE Aktion = RECORD
  109.         KillPlanes   : BOOLEAN;
  110.         Remap        : BOOLEAN;
  111.      END; (* RECORD Aktion *)
  112.  
  113. TYPE INTPOINTER = POINTER TO INTEGER;
  114.  
  115. VAR AltDirLockPtr : FileLockPtr;
  116.     Anzahl        : LONGINT;
  117.     DirInfo       : FileInfoBlock;
  118.     DirLockPtr    : FileLockPtr;
  119.     Error         : LONGINT;
  120.     Fehler        : BOOLEAN;
  121.     i             : INTEGER;
  122.     Icon          : DiskObjectPtr;
  123.     IconAktion    : Aktion;
  124.     IconImageGad,
  125.     IconImageSel  : ImagePtr;
  126.     IconName      : String;
  127.     IconNameLaenge: INTEGER;
  128.     OutPut        : FileHandlePtr;
  129.     ParDirLockPtr : FileLockPtr;
  130.  
  131. (* --------------------------------------------------------------------- *)
  132.  
  133. PROCEDURE BearbeiteImage (IconImage : ImagePtr;
  134.                           IconAktion: Aktion;
  135.                           OutPut    : FileHandlePtr);
  136.  
  137.    (* macht die eigentlicht Bearbeitung *)
  138.  
  139.    CONST PlaneError = ErrorText + " cannot handle this kind of images!\n\o";
  140.  
  141.    VAR Anzahl       : LONGINT;
  142.        i            : INTEGER;
  143.        ImagePlane,
  144.        ImagePlane2  : INTPOINTER;
  145.        ImageNewSize,
  146.        ImageOldSize : LONGINT;
  147.        IPlaneSize   : INTEGER;
  148.        Maske        : INTEGER;
  149.  
  150.    (* ------------------------------------------------------------------ *)
  151.  
  152.    PROCEDURE ExOR (Wort1, Wort2: INTEGER): INTEGER;
  153.  
  154.       (* wendet den Maschinenbefehl EOR auf Wort1 und Wort2 an *)
  155.  
  156.       VAR Ergebnis: INTEGER;
  157.  
  158.       (* --------------------------------------------------------------- *)
  159.  
  160.       BEGIN (* Funktion ExOR *)
  161.  
  162.       ASSEMBLE (
  163.          MOVE.W Wort1(A5),D0
  164.          MOVE.W Wort2(A5),D1
  165.          EOR.W  D1,D0
  166.          MOVE.W D0,Ergebnis(A5)
  167.       END);
  168.  
  169.       RETURN Ergebnis;
  170.    END ExOR (* Funktion *);
  171.  
  172.    (* ------------------------------------------------------------------ *)
  173.  
  174.    PROCEDURE LogAND (Byte1, Byte2: SHORTCARD): SHORTCARD;
  175.  
  176.       (* wendet den Maschinenbefehl AND auf Byte1 und Byte2 an *)
  177.  
  178.       VAR Ergebnis: SHORTCARD;
  179.  
  180.       (* --------------------------------------------------------------- *)
  181.  
  182.       BEGIN (* Funktion LogAND *)
  183.  
  184.       ASSEMBLE (
  185.          MOVE.B Byte1(A5),D0
  186.          MOVE.B Byte2(A5),D1
  187.          AND.B  D1,D0
  188.          MOVE.B D0, Ergebnis(A5)
  189.       END);
  190.  
  191.       RETURN Ergebnis;
  192.    END LogAND (* Funktion *);
  193.  
  194.    (* ------------------------------------------------------------------ *)
  195.  
  196.    PROCEDURE Wort (Zahl: INTEGER): INTEGER;
  197.  
  198.       (* vergrößert Zahl so weit, daß Zahl durch 16 teilbar wird *)
  199.  
  200.       BEGIN (* Funktion Wort *);
  201.  
  202.       IF Zahl MOD 16 # 0 THEN
  203.          IF (MAX (INTEGER) - 15) >= Zahl THEN
  204.             Zahl := Zahl + (16 - (Zahl MOD 16));
  205.          END (* IF (MAX *);
  206.       END (* IF Zahl MOD 16 *);
  207.  
  208.       RETURN Zahl;
  209.    END Wort (* Funktion *);
  210.  
  211.    (* ------------------------------------------------------------------ *)
  212.  
  213.    BEGIN (* Prozedur BearbeiteImage *)
  214.  
  215.    WITH IconImage^ DO
  216.       IF IconAktion.KillPlanes THEN
  217.          IF depth > 2 THEN
  218.             planePick := LogAND (planePick, 3);
  219.             planeOnOff := LogAND (planeOnOff, 3);
  220.  
  221.             (* meiner Meinung nach gehört das folgende dahin, erzeugt
  222.                jedoch einen Guru mit Spätzünder (z. Bsp. 81000005):   *)
  223.  
  224.             (*
  225.             ImagePlane := imageData;
  226.             INC (ImagePlane, (2 * Wort (width) * height) DIV 8);
  227.             FreeMem (ImagePlane, ((depth - 2) * Wort (width) * height) DIV 8);
  228.             *)
  229.  
  230.             depth := 2; (* sonst wird die kaputte Bitplane doch gezeichnet *)
  231.          END (* IF depth *);
  232.       END (* IF IconAction.KillPlanes *);
  233.  
  234.       IF IconAktion.Remap THEN
  235.          IF depth > 1 THEN
  236.             IF LogAND (planePick, 3) = 3 THEN
  237.                ImagePlane := imageData;
  238.                ImagePlane2 := imageData;
  239.                IPlaneSize := (Wort (width) * height) DIV 8;
  240.                INC (ImagePlane2, IPlaneSize);
  241.  
  242.                FOR i := 1 TO (IPlaneSize DIV 2) DO
  243.                   Maske := ExOR (ImagePlane^, ImagePlane2^);
  244.                   ImagePlane^ := ExOR (ImagePlane^, Maske);
  245.                   ImagePlane2^ := ExOR (ImagePlane2^, Maske);
  246.  
  247.                   INC (ImagePlane, SIZE (ImagePlane^));
  248.                   INC (ImagePlane2, SIZE (ImagePlane2^));
  249.                END (* FOR i *);
  250.  
  251.             ELSE (* IF LogAND *)
  252.                Anzahl := Write (OutPut, ADR (PlaneError), SIZE (PlaneError));
  253.             END (* IF LogAND *);
  254.          END (* IF depth *);
  255.       END (* IF IconAction.Remap *);
  256.    END (* WITH IconImage^ *);
  257. END BearbeiteImage (* Prozedur *);
  258.  
  259. (* --------------------------------------------------------------------- *)
  260.  
  261. PROCEDURE Usage (OutPut: FileHandlePtr);
  262.  
  263.    (* zeigt eine Usage und beendet das Programm *)
  264.  
  265.    CONST Usag1Text = " Usage:\n\o";
  266.          Usag2Text = " ~~~~~~\n\o";
  267.          Usag3Text = " RemapInfo Options/Files Options/Files ...\n\n\o";
  268.          FilesText = " Files  : Icons without .info extension\n\o";
  269.          OptioText = " Options: ±REMAP ±KILLPLANES (both switches)\n\n\o";
  270.          DefauText = " Default is +REMAP -KILLPLANES\n\n\o";
  271.          WarniText = " Please have a look at the manual to avoid damage to" +
  272.                      " Your icons!\n\n\o";
  273.  
  274.          Clic2Text = " Click at" + RemapText + ", then press and hold down the\n\o";
  275.          Clic3Text = " SHIFT-key, then click at all icons to process and\n\o";
  276.          Clic4Text = " double-click the last one." + RemapText + " will do the rest.\n\n\o";
  277.          Tool1Text = " Tool-Types:\n\o";
  278.          Tool2Text = " ~~~~~~~~~~~\n\o";
  279.          Tool3Text = " ±REMAP, +REMAP is default\n\o";
  280.          Tool4Text = " ±KILLPLANES, -KILLPLANES is default\n\n\o";
  281.  
  282.    VAR Anzahl: LONGINT;
  283.  
  284.    (* ------------------------------------------------------------------ *)
  285.  
  286.    BEGIN (* Prozedur Usage *)
  287.  
  288.    returnVal := 10;
  289.  
  290.    Anzahl := Write (OutPut, ADR (Usag1Text), SIZE (Usag1Text));
  291.    Anzahl := Write (OutPut, ADR (Usag2Text), SIZE (Usag2Text));
  292.  
  293.    IF NOT wbStarted THEN
  294.       Anzahl := Write (OutPut, ADR (Usag3Text), SIZE (Usag3Text));
  295.       Anzahl := Write (OutPut, ADR (FilesText), SIZE (FilesText));
  296.       Anzahl := Write (OutPut, ADR (OptioText), SIZE (OptioText));
  297.       Anzahl := Write (OutPut, ADR (DefauText), SIZE (DefauText));
  298.  
  299.    ELSE (* IF NOT wbStarted *)
  300.       Anzahl := Write (OutPut, ADR (Clic2Text), SIZE (Clic2Text));
  301.       Anzahl := Write (OutPut, ADR (Clic3Text), SIZE (Clic3Text));
  302.       Anzahl := Write (OutPut, ADR (Clic4Text), SIZE (Clic4Text));
  303.       Anzahl := Write (OutPut, ADR (Tool1Text), SIZE (Tool1Text));
  304.       Anzahl := Write (OutPut, ADR (Tool2Text), SIZE (Tool2Text));
  305.       Anzahl := Write (OutPut, ADR (Tool3Text), SIZE (Tool3Text));
  306.       Anzahl := Write (OutPut, ADR (Tool4Text), SIZE (Tool4Text));
  307.    END (* IF NOT wbStarted *);
  308.  
  309.    Anzahl := Write (OutPut, ADR (WarniText), SIZE (WarniText));
  310.  
  311.    Terminate;
  312. END Usage (* Prozedur *);
  313.  
  314. (* --------------------------------------------------------------------- *)
  315. (* --------------------------------------------------------------------- *)
  316.  
  317. BEGIN (* Hauptprogramm *)
  318.  
  319. AltDirLockPtr := NIL;
  320. DirLockPtr := NIL;
  321. Icon := NIL;
  322. OutPut := NIL;
  323. ParDirLockPtr := NIL;
  324.  
  325. WITH IconAktion DO
  326.    KillPlanes := DefKillPlanes;
  327.    Remap := DefRemap;
  328. END (* WITH IconAktion *);
  329.  
  330. IF wbStarted THEN
  331.    OutPut := Open (ADR (WinDefs), newFile);
  332.  
  333. ELSE (* IF wbStarted *)
  334.    OutPut := Output ();
  335. END (* IF wbStarted *);
  336.  
  337. Assert (OutPut # NIL, ADR (KeinOutputText));
  338.  
  339. Anzahl := Write (OutPut, ADR (Copyright), SIZE (Copyright));
  340.  
  341. IF NumArgs () = 0 THEN
  342.    Usage (OutPut);
  343. END (* IF NumArgs () *);
  344.  
  345. IF NumArgs () = 1 THEN
  346.    GetArg (1, IconName, IconNameLaenge);
  347.  
  348.    IF IconName [0] = "?" THEN
  349.       Usage (OutPut);
  350.    END (* IF IconName *);
  351. END (* IF NumArgs *);
  352.  
  353. Anzahl := Write (OutPut, ADR (Start1Text), SIZE (Start1Text));
  354. Anzahl := Write (OutPut, ADR (Start2Text), SIZE (Start2Text));
  355.  
  356. IF wbStarted THEN
  357.    GetArg (0, IconName, IconNameLaenge);
  358.    Icon := GetDiskObject (ADR (IconName));
  359.  
  360.    IF Icon # NIL THEN
  361.       IF FindToolType (Icon^.toolTypes, ADR (OptKillPlanesPlus)) # NIL THEN
  362.          IconAktion.KillPlanes := TRUE;
  363.          Anzahl := Write (OutPut, ADR (KillPlanesOnText), SIZE (KillPlanesOnText));
  364.       END (* IF FindToolType *);
  365.  
  366.       IF FindToolType (Icon^.toolTypes, ADR (OptKillPlanesMinus)) # NIL THEN
  367.          IconAktion.KillPlanes := FALSE;
  368.          Anzahl := Write (OutPut, ADR (KillPlanesOffText), SIZE (KillPlanesOffText));
  369.       END (* IF FindToolType *);
  370.  
  371.       IF FindToolType (Icon^.toolTypes, ADR (OptRemapPlus)) # NIL THEN
  372.          IconAktion.Remap := TRUE;
  373.          Anzahl := Write (OutPut, ADR (RemapOnText), SIZE (RemapOnText));
  374.       END (* IF FindToolType *);
  375.  
  376.       IF FindToolType (Icon^.toolTypes, ADR (OptRemapMinus)) # NIL THEN
  377.          IconAktion.Remap := FALSE;
  378.          Anzahl := Write (OutPut, ADR (RemapOffText), SIZE (RemapOffText));
  379.       END (* IF Compare *);
  380.  
  381.       FreeDiskObject (Icon);
  382.       Icon := NIL;
  383.    END (* IF Icon *);
  384. END (* IF wbStarted *);
  385.  
  386. FOR i := 1 TO NumArgs () DO
  387.    GetArg (i, IconName, IconNameLaenge);
  388.  
  389.    IF wbStarted AND (IconNameLaenge = 0) THEN
  390.       DirLockPtr := GetLock (i);
  391.  
  392.       IF DirLockPtr # NIL THEN
  393.          Fehler := Examine (DirLockPtr, ADR (DirInfo));
  394.  
  395.          Copy (IconName, DirInfo.fileName);
  396.          IconNameLaenge := Length (IconName);
  397.  
  398.          ParDirLockPtr := ParentDir (DirLockPtr);
  399.  
  400.          IF ParDirLockPtr # NIL THEN
  401.             AltDirLockPtr := CurrentDir (ParDirLockPtr);
  402.          END (* IF ParDirLockPtr *);
  403.       END (* IF DirLockPtr *);
  404.    END (* IF wbStarted AND *);
  405.  
  406.    IF IconNameLaenge < StringMax THEN
  407.       IF (IconName [0] = OptPlus) OR (IconName [0] = OptMinus) THEN
  408.          CapString (IconName);
  409.  
  410.          IF Compare (IconName, OptKillPlanesPlus) = 0 THEN
  411.             IconAktion.KillPlanes := TRUE;
  412.             Anzahl := Write (OutPut, ADR (KillPlanesOnText), SIZE (KillPlanesOnText));
  413.  
  414.          ELSIF Compare (IconName, OptKillPlanesMinus) = 0 THEN
  415.             IconAktion.KillPlanes := FALSE;
  416.             Anzahl := Write (OutPut, ADR (KillPlanesOffText), SIZE (KillPlanesOffText));
  417.  
  418.          ELSIF Compare (IconName, OptRemapPlus) = 0 THEN
  419.             IconAktion.Remap := TRUE;
  420.             Anzahl := Write (OutPut, ADR (RemapOnText), SIZE (RemapOnText));
  421.  
  422.          ELSIF Compare (IconName, OptRemapMinus) = 0 THEN
  423.             IconAktion.Remap := FALSE;
  424.             Anzahl := Write (OutPut, ADR (RemapOffText), SIZE (RemapOffText));
  425.          END (* IF Compare *);
  426.  
  427.       ELSE (* IF IconName [0] *)
  428.          Icon := GetDiskObject (ADR (IconName));
  429.  
  430.          IF Icon # NIL THEN
  431.             Anzahl := Write (OutPut, ADR (Processing1Text), SIZE (Processing1Text));
  432.             Anzahl := Write (OutPut, ADR (IconName), IconNameLaenge);
  433.             Anzahl := Write (OutPut, ADR (Processing2Text), SIZE (Processing2Text));
  434.  
  435.             IF (Icon^.gadget.gadgetType = boolGadget) AND
  436.                (gadgImage IN Icon^.gadget.flags) THEN
  437.                IconImageGad := Icon^.gadget.gadgetRender;
  438.                IconImageSel := Icon^.gadget.selectRender;
  439.  
  440.                IF IconImageGad # NIL THEN
  441.                   BearbeiteImage (IconImageGad, IconAktion, OutPut);
  442.                END (* IF IconImageGad *);
  443.  
  444.                IF gadgHImage IN Icon^.gadget.flags THEN
  445.                   IF IconImageSel # NIL THEN
  446.                      BearbeiteImage (IconImageSel, IconAktion, OutPut);
  447.                   END (* IF IconImageSel *);
  448.                END (* IF gadgHImage *);
  449.  
  450.                Fehler := PutDiskObject (ADR (IconName), Icon);
  451.  
  452.             ELSE (* IF (Icon^. *)
  453.                Anzahl := Write (OutPut, ADR (Typ1Text), SIZE (Typ1Text));
  454.                Anzahl := Write (OutPut, ADR (IconName), IconNameLaenge);
  455.                Anzahl := Write (OutPut, ADR (Typ2Text), SIZE (Typ2Text));
  456.             END (* IF (Icon^.gadget.type *);
  457.  
  458.             FreeDiskObject (Icon);
  459.             Icon := NIL;
  460.  
  461.          ELSE (* IF Icon # NIL *)
  462.             Anzahl := Write (OutPut, ADR (NoIcon1Text), SIZE (NoIcon1Text));
  463.             Anzahl := Write (OutPut, ADR (IconName), IconNameLaenge);
  464.             Anzahl := Write (OutPut, ADR (NoIcon2Text), SIZE (NoIcon2Text));
  465.          END (* IF Icon # NIL *);
  466.       END (* IF IconName [0] *);
  467.    END (* IF IconNameLaenge *);
  468. END (* FOR i *);
  469.  
  470. (* --------------------------------------------------------------------- *)
  471.  
  472. CLOSE; (* aufräumen... *)
  473.  
  474. IF Icon # NIL THEN
  475.    FreeDiskObject (Icon);
  476.    Icon := NIL;
  477. END (* IF Icon *);
  478.  
  479. IF wbStarted THEN
  480.    Delay (Seconds * ticksPerSecond);
  481.    Close (OutPut);
  482.    OutPut := NIL;
  483. END (* IF wbStarted *);
  484.  
  485. END RemapInfo (* Modul *).
  486.